home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / cexpert.zip / MCH8.LST < prev    next >
File List  |  1990-09-15  |  21KB  |  794 lines
  1.      Listing 8-1 A Sample C Program for Forward Chaining
  2.  
  3. /*
  4. **   forward.c
  5. **   
  6. **   Description: This program is to implement the forward chain in reasoning
  7. */
  8.  
  9.  
  10. /*--------------------------------------------------include-------------*/
  11.  
  12. #include <stdio.h>
  13. #include <math.h>
  14. #include "cons.h"
  15. #include "rule.h"
  16. #include "fact.h"
  17.  
  18. /*----------------------------------------------forward_chain()--------*/
  19.  
  20. /*
  21. ** E.g.
  22. **
  23. ** Rule Base:
  24. **      1 IF ((d ?x)) THEN (c ?x) 1.0
  25. **      2 IF ((a ?x)(c ?x)) THEN (b ?x) 1.0
  26. ** Predicate Base:
  27. **      ((d 2), 0.7);
  28. **
  29. ** predicate = (a 2), certainty = 0.9, rule_base = RuleDataBase
  30. **
  31. ** forward_chain(predicate,certainty,rule_base) ===>
  32. ** New Predicate Base:
  33. **      ((d 2), 0.7), ((a 2), 0.9), ((c 2), 0.7), ((b 2), 0.7)
  34. **
  35. */
  36.  
  37. void forward_chain(predicate,certainty,rule_base)
  38.  
  39. cons    *predicate;                      /*predicate of beginning fact*/
  40. double  certainty;                       /*certainty of beginning fact*/
  41. rule    *rule_base;                      /*rule base*/
  42.  
  43. /*----------------------------------------------------------------------*/
  44. {
  45.     int     i;                       /*loop variable*/ 
  46.     int     flag = 0;                /*flag to show rule base status*/
  47.     double  *cert,cert1;             /*certainty of new fact*/
  48.     double  *fact_cert;   
  49.     rule    *rulep;                  /*rule base pointer*/
  50.     fact    *factp,*new_fact;
  51.     cons    *subst = NULL;
  52.     cons    *new_concl,*temp;è    extern  cons *lookup_pkb_fact1();
  53.     
  54.     cert1 = 1.0;         
  55.     factp = PkbList;                 /*initial to fact base*/
  56.     rulep = rule_base;               /*initial to rule base*/
  57.     
  58.     pkb_stash(predicate,certainty);  /*stash the fact into fact_base*/
  59.     while(rulep != NULL)             /*search all the rule base*/
  60.     {
  61.                             /*only concern conjunction*/
  62.         for(i = 1; i <= length(rulep->premise); i++)
  63.         {
  64.               temp = nth_list(i,rulep->premise);
  65.               subst=lookup_pkb_fact1(CAR(temp),fact_cert);
  66.               if(subst != NULL)         /*find a matched rule's part*/
  67.               {
  68.                flag = 1;               /*set up success flag*/
  69.                rulep->premise = subst_prop(rulep->premise,subst);
  70.                rulep->conclusion = subst_pred(rulep->conclusion,subst);
  71.                Min(cert1,(*fact_cert),cert); /*MYCIN certainty calcul*/
  72.                cert1 = (*cert);
  73.               }
  74.               else 
  75.               {
  76.                flag = 0;
  77.                break;
  78.               }
  79.         }
  80.         if (flag == 1)     /*find fact unified with premise*/
  81.         {
  82.                flag = 0;                    /*reset the flag*/
  83.                            /*get the substituted rule conclusion*/
  84.               new_concl = rulep->conclusion;
  85.               cert1 = cert1*rulep->certainty;/* MYCIN certainty cal*/
  86.               pkb_stash(new_concl,cert1);
  87.               cert1 = 1.0;                 /*reset the certainty*/
  88.               rule_base = delete_rule(rulep,rule_base);/*the fired rule is kicked out*/
  89.               rulep = rule_base;     /*restart search rule base*/
  90.             }
  91.         else 
  92.         {
  93.               rulep = rulep->next;   /*search for next rule*/
  94.             }
  95.         factp = PkbList;             /*restart search fact base*/
  96.     }
  97. }
  98.  
  99.  
  100. /*
  101. **    stash_fact_pkb(predicate,cert)
  102. **    Before stash the fact into pkb, check whether it is already there or not
  103. **
  104. */
  105. stash_fact_pkb(pred,cert)
  106. cons    *pred;                /*predicate calculus format of fact*/
  107. double   cert;                /*fact's certainty*/
  108. {
  109.          cons       *fp;
  110.      double     *cert_out;
  111.      
  112.      fp = lookup_pkb_fact(pred,cert_out);
  113.      if(fp == NULL)       
  114.      {
  115.          pkb_stash(pred,cert);
  116.      }
  117.          else /*the fact is already there*/
  118.      return;
  119. }
  120.          
  121.  
  122.  
  123. /*-----------------------------------------------lookup_pkb_fact1()--------*/
  124.  
  125. /*
  126. ** Different from the lookup_pkb_fact() in facts.c file. The difference is
  127. ** the argument.
  128. */
  129.  
  130. cons *lookup_pkb_fact1(pattern,cert)
  131. cons *pattern;
  132. double *cert;
  133. {
  134.   fact *fp = PkbList;
  135.   cons *subst = NULL;
  136.  
  137.   *cert = 0.0;  
  138.   while (fp) {
  139.     subst = unify_pred_c(pattern,fp->predicate);
  140.     if (subst != NULL) {
  141.       *cert = fp->cert;
  142.       break;
  143.     } else {
  144.       fp = fp->next;
  145.     }
  146.   }
  147.   return subst;
  148. }
  149.  
  150.           Listing 8-2  A Sample Program for Substitution 
  151.  
  152. /*
  153. **  substitu.c:  Functions for manipulating substitutions.
  154. **
  155. **
  156. */
  157.  
  158. /*--------------------------------------------------include--------------*/
  159.  
  160. #include <stdio.h>
  161. #include "cons.h"
  162.  
  163.  
  164. /*--------------------------------------------------twotees()------------*/
  165.  
  166. cons *twotees() 
  167. {
  168.   static cons *tt = NULL;
  169.   
  170.   if (tt == NULL) {
  171.     tt = mklist2("t","t");
  172.   } 
  173.   return tt;
  174. }
  175.  
  176.  
  177.  
  178. /*--------------------------------------------------ltwotees()------------*/
  179.  
  180. cons *ltwotees()
  181. {
  182.   static cons *ltt = NULL;
  183.  
  184.   if (ltt == NULL) {
  185.     ltt = mkcons(CAR_LIST,twotees(),NULL);
  186.   }
  187.   return ltt;
  188. }
  189.  
  190.  
  191.  
  192. /*--------------------------------------------------lltwotees()------------*/
  193.  
  194. cons *lltwotees()
  195. {
  196.   static cons *lltt = NULL;
  197.  
  198.   if (lltt == NULL) {
  199.     lltt = mkcons(CAR_LIST,ltwotees(),NULL);
  200.   }
  201.   return lltt;
  202. }
  203.  
  204. /*--------------------------------------------------join_subst()------------*/
  205.  
  206. /*
  207. ** z1 is subst for ONE term.
  208. */
  209.  
  210. cons *join_subst(z1,z2)
  211. cons *z1,*z2;
  212. {
  213.   cons *retval;
  214.   
  215.   if (equal(z1,ltwotees())) {
  216.     return z2;
  217.   } else if (equal(z2,ltwotees())) {
  218.     return z1;
  219.   } else {
  220.     return(mkcons(CAR_LIST,z1,z2));      
  221.   }
  222. }
  223.  
  224.  
  225.  
  226. /*--------------------------------------------------subst_list()------------*/
  227.  
  228. /*
  229. ** Variable substitution
  230. ** %% Use of system fn like subst would be real efficient, except that it
  231. ** does not deal with nonrecursiveness.
  232. ** Performs a variable substitution on list, nonrecursively
  233. ** (only one substitution applied to each atomic term).  
  234. ** Usage: E.g. subst_list((p ?x ?y),((?x 1)(?y 2))) ===> (p 1 2)
  235. */
  236.  
  237.  
  238. cons *subst_list(list,substi)
  239. cons *substi,*list;
  240. {
  241.   cons *new_list = NULL;
  242.   cons *substp;
  243.   cons *term;
  244.   cons *tmp;
  245.   
  246.   while (list != NULL) {
  247.     term = list->car.p;
  248.     substp = substi;        /* get 1st substitution */
  249.     while (substp != NULL) {
  250.       if (term->type == CAR_STRING && !strcmp(term->car.s,
  251.                          substp->car.p->car.p->car.s)) {
  252.     term = substp->car.p->cdr->car.p;
  253.     break;
  254.       }
  255.       substp = substp->cdr;        /* make more subst's */
  256.     }
  257.     new_list = nconc(new_list,mkcons(CAR_LIST,copy_list(term),NULL));
  258.     list = list->cdr;è  }
  259.   return new_list;
  260. }
  261.  
  262.  
  263. /*--------------------------------------------------subst_prop()------------*/
  264.  
  265. /*
  266. ** subst_prop(): performs a variable substitution on proposition
  267. ** Returns a copy of the proposition with replacements according to the
  268. ** substitution list.
  269. ** Usage:  E.g. subst_prop(((p ?x)(q ?y)),((?x 1)(?y 2))) ===> ((p 1)(q 2))
  270. **
  271. */
  272.       
  273. cons *subst_prop(list,substi)
  274. cons *substi,*list;
  275. {
  276.     int       i;
  277.     cons      *temp1,*temp2;
  278.     
  279.     temp1 = NULL;
  280.     if(list == NULL)
  281.     {
  282.         killcons(temp1);
  283.         killcons(temp2);
  284.         return NULL;
  285.     }
  286.     for(i = 1; i <= length(list); i++)
  287.     {
  288.         temp2 = nth_list(i,list);
  289.         temp1 = nconc(temp1,
  290.                  mkcons(CAR_LIST,subst_list(CAR(temp2),substi),NULL));
  291.     }
  292.     killcons(temp1);
  293.     killcons(temp2);
  294.     return temp1;
  295. }
  296.  
  297.  
  298.  
  299. /*--------------------------------------------------subst_pred()------------*/
  300.  
  301. /*
  302. ** subst_pred(): Performs nonrecursive variable substitution on a predicate
  303. ** Would be more mem-efficient if result SHARED with pred.
  304. ** Usage: E.g. subst_pred((p ?x ?y),((?x 1)(?y 2))) ===> (p 1 2)
  305. */
  306.         
  307. cons *subst_pred(pred,subst)
  308. cons *pred,*subst;
  309. {
  310.   return subst_list(pred,subst);
  311. }
  312.  
  313. cons *substitute_pred(pred,subst)
  314. cons *pred,*subst;
  315. {
  316.     int  i,j;
  317.     cons *new_list = NULL;
  318.     cons *substp;
  319.     cons *term;
  320.     cons *tmp;
  321.     
  322.     for(i = 1; i <= length(pred); i++)
  323.     {
  324. /*        term = CAR(nth_list(i,pred));*/
  325.         substp = subst;
  326.         for(j = 1; j <= length(subst); j++)
  327.         {
  328.             ;
  329.         }
  330.     }
  331. }
  332.  
  333.  
  334.  
  335. /*--------------------------------------------------subst_substlist()-----*/
  336.  
  337. /*
  338. ** subst_substlist(): perform a substitution on a substitution list 
  339. ** s-s( (((?x 1)) ((?x 2))) , ((?x ?y)) ) ==> (((?y 1)) ((?y 2)))
  340. */
  341.  
  342. cons *subst_substlist(substlist,subst)
  343. cons *substlist,*subst;
  344. {
  345.   cons *new_substlist = NULL;
  346.   cons *new_subst     = NULL;
  347.   cons *new_pair      = NULL;
  348.   cons *term,*substp,*substip,*tmp;
  349.  
  350.   while (substlist != NULL) {        /* for each substitution */
  351.     new_subst = NULL;
  352.     substp = substlist->car.p;
  353.     while (substp != NULL) {        /* for each pair */
  354.       term = substp->car.p->car.p;
  355.       substip = subst;
  356.       while (substip != NULL) {        /* for each substitution-pair */
  357.         if (!strcmp(term->car.s,substip->car.p->car.p->car.s)) {
  358.       term = substip->car.p->cdr->car.p;
  359.       break;
  360.         }
  361.     substip = substip->cdr;
  362.       }
  363.       new_subst = nconc(new_subst,
  364.         mkcons(CAR_LIST,
  365.                mkcons(CAR_LIST,
  366.                   copy_list(term),
  367.               mkcons(CAR_LIST,copy_list(substp->car.p->cdr->car.p),                 NULL)),
  368.            NULL));
  369.       
  370.       substp = substp->cdr;
  371.     }
  372.     new_substlist = nconc(new_substlist,mkcons(CAR_LIST,new_subst,NULL));
  373.     substlist = substlist->cdr; 
  374.   }
  375.   return new_substlist;  
  376. }
  377.  
  378.  
  379.  
  380. /*----------------------------------------------test_subst_used()-----*/
  381.  
  382. /*
  383. **  test_subst_used():Tells if substitution has been used.
  384. **  Usage: E.g.
  385. **     test_subst_used(((?x  5)),(((?x  1))))  ===>  0
  386. **      test_subst_used(((?x  5)),(((?x  5))))  ===>  1
  387. **
  388. */
  389.  
  390. int test_subst_used(list1,prev_subst)
  391. cons  *list1,*prev_subst;
  392. {
  393.     int   i,j;
  394.     int   flag = 0;
  395.     cons  *temp1,*temp2;
  396.     
  397.     for(i=1;i<=length(list1);i++)
  398.     {
  399.        flag = 0;
  400.        temp1 = nth_list(i,list1);
  401.        for(j=1;j<=length(prev_subst);j++)
  402.        {
  403.         temp2 = nth_list(j,prev_subst);
  404.         if(equal(temp1,CAR(temp2)))
  405.         {
  406.             flag = 1;
  407.             break;
  408.         }
  409.        }
  410.        if(flag == 1)
  411.        {
  412.         return 1;                /*at least one not used*/
  413.        }
  414.           }
  415.       return 0;                      /*all used*/
  416. }
  417.       Listing 8-3  A Sample Program for Backward Chaining
  418.  
  419. /*
  420. **    backward.c
  421. **    Description:   This program is to implement backward chain in the 
  422. **             reasoning.
  423. **    Usage:  E.g.
  424. **            Rule Base:
  425. **                 1. IF ((a ?x)(b ?x)) THEN (c ?x) 1.0
  426. **            Predicate Base:
  427. **                ((c 2), 1.0)
  428. **            previous substitutions: NULL
  429. **            backward_chain((c ?y),NULL) ===> ((?y 2), 1.0)
  430. */
  431.  
  432. /*-----------------------------------------------------------include-----*/
  433.  
  434. #include <stdio.h>
  435. #include <math.h>
  436. #include "cons.h"
  437. #include "rule.h"
  438. #include "fact.h"
  439. #include "goal.h"
  440.  
  441. /*-----------------------------------------------------------define-------*/
  442.  
  443. #define ONE        1
  444. #define TWO        2
  445.  
  446. /*
  447. ** backward_chain
  448. */
  449.  
  450. /*-------------------------------------------------------backward_chain()---*/
  451.  
  452. Ret_Pair    *backward_chain(goal,prev_subs)
  453.  
  454. cons        *goal;                  /*the goal trying to achieve*/
  455. cons        *prev_subs;                       /*previous substitution list*/
  456.  
  457. /*-------------------------------------------------------------------------*/
  458. {
  459.   int       flag = 0;
  460.   rule      *rp;
  461.   cons      *subs,*concl_pred_subst,*subst_for_vars,*subbed_prem;
  462.   cons      *prem_prev_substs,*prem_subs,*true_concl_pred_subst;
  463.   cons      *true_concl_pred,*tmp1,*tmp2;
  464.   cons      *possible_subst;
  465.   Ret_Pair  *ret_pair,*temp1;
  466.  
  467.  
  468.   
  469.   #ifdef DEBUG
  470.      printf("\nIn backward_chain:");
  471.      printf("\ngoal:  ");è     lprint(goal,C_FILE,stdout);
  472.      printf("  prev_substs:  ");
  473.      lprint(prev_subs,C_FILE,stdout);
  474.   #endif
  475.       
  476.   possible_subst=NULL;
  477.   subs = NULL;
  478.   true_concl_pred = NULL;
  479.   rp = RuleDatabase;                          /*point to Rule base*/
  480.   ret_pair = init_ret_pair();                  /*initialize the ret_pair*/
  481.   temp1    = init_ret_pair();      
  482.   while( rp != NULL)                          /*trying to find a match rule*/
  483.   {
  484.       subs = unify_pred_nv(rp->conclusion,goal); 
  485.       if(subs != NULL)                    /*find a rule match goal*/
  486.       {
  487.           flag = 1;                   /*find a rule*/     
  488.           break;
  489.       }
  490.       rp = rp->next;
  491.   }
  492.   
  493.   if(!flag)                                    /*not find match rule, back*/
  494.   {
  495.     return ret_pair;
  496.   }
  497.   tmp1 = nth_list(ONE,subs);
  498.   tmp2 = nth_list(TWO,subs);
  499.   concl_pred_subst = CAR(tmp1);
  500.   subst_for_vars = CAR(tmp2);
  501.   subbed_prem = subst_prop(rp->premise,concl_pred_subst);
  502.   if(length(subbed_prem) == 1)           /*not conjunction premise*/
  503.   {
  504.     subbed_prem = CAR(subbed_prem);
  505.   }
  506.   prem_prev_substs = subst_substlist(prev_subs,subst_for_vars);
  507.   temp1 = achieve(subbed_prem,prem_prev_substs);
  508.   prem_subs = temp1->subst;
  509.   if(prem_subs != NULL)
  510.   {
  511.         true_concl_pred_subst = nconc(concl_pred_subst,prem_subs);
  512.         true_concl_pred = subst_pred(rp->conclusion,true_concl_pred_subst);
  513.         possible_subst = unify_pred_c(goal,true_concl_pred);
  514.       if(!test_subst_used(possible_subst,prev_subs)) /*not used in prev*/
  515.     {
  516.          ret_pair->subst = possible_subst;
  517.          ret_pair->certainty = rp->certainty * temp1->certainty;
  518.     }
  519.    }
  520.    #ifdef DEBUG
  521.         printf("\nreturn from backward_chain:");
  522.         printf("\nret_pair->subst::");
  523.         lprint(ret_pair->subst,C_FILE,stdout);
  524.         printf("  ret_pair->certainty::%g",ret_pair->certainty);
  525.    #endif    è   return ret_pair;
  526. }
  527.  
  528.  
  529.  
  530.         Listing 8-4   A Sample Program for Forward Tracking
  531.  
  532. /*
  533. **    frwdtrack.c
  534. **    Description:   This program is to implement forward track step 
  535. **             in reasoning.
  536. */
  537.  
  538. /* Returns the substitution that makes conjuncts true.  (Does NOT return
  539. ** solution with s_i_t; that should be prepended by caller)
  540. ** If prev_substs is specified then we're calling the conjunct for the first
  541. ** time, but where some solutions have been tried already elsewhere
  542. */
  543. /*------------------------------------------------------include---------*/
  544.  
  545. #include   <stdio.h>
  546. #include   <math.h>
  547. #include   "cons.h"
  548. #include   "goal.h"
  549.  
  550.  
  551. /*------------------------------------------------------frwdtrack()------*/
  552.  
  553.  
  554. Ret_Pair   *Frwdtrack(gs_obj,conjuncts,subs_in_there,prev_substs)
  555.  
  556. Goal_Stack       *gs_obj;                      /*goal stack object*/
  557. cons             *conjuncts;                   /*conjuncts list*/
  558. cons             *subs_in_there;           /*substitutions in there*/
  559. cons             *prev_substs;               /*previous substitution list*/
  560.  
  561. /*-----------------------------------------------------------------------*/
  562. {
  563.     Ret_Pair        *ret_pair;        /*return pair: subst,cert*/
  564.         Ret_Pair        *temp_pair1,*temp_pair2; 
  565.     Goal_Frame      *goal_frame;
  566.     cons            *temp1,*tmp1;
  567.     double          *cert;
  568.     
  569.     #ifdef DEBUG
  570.         printf("\nIn Frwdtrack");
  571.         printf("\ngs_obj ::");
  572.         print_goal_obj(gs_obj);
  573.         printf("\nconjuncts :: ");
  574.         lprint(conjuncts,C_FILE,stdout);
  575.         printf(" sit :: ");
  576.         lprint(subs_in_there,C_FILE,stdout);
  577.         printf(" prev_substs :: ");
  578.         lprint(prev_substs,C_FILE,stdout);
  579.     #endif    
  580.         
  581.     ret_pair = init_ret_pair();        
  582.     temp_pair1 = init_ret_pair();
  583.     if(conjuncts == NULL)è    {
  584.         ret_pair->subst = mkcons(CAR_LIST,mklist2("t","t"),NULL);
  585.         ret_pair->certainty = 1.0;
  586.         return ret_pair;
  587.         }
  588.     else
  589.     {
  590.         temp_pair1 = achieve(CAR(conjuncts),prev_substs);
  591.         if(temp_pair1->subst != NULL)
  592.         {
  593.            if (goal_frame = (Goal_Frame *) malloc(sizeof(Goal_Frame)))
  594.            {
  595.             goal_frame->goal = CAR(conjuncts);
  596.             goal_frame->sit = subs_in_there;
  597.             goal_frame->ps = prev_substs;
  598.             goal_frame->roc = CDR(conjuncts);
  599.             goal_frame->soln = temp_pair1->subst;
  600.             goal_frame->cert = temp_pair1->certainty;
  601.             push_a_frame(goal_frame,gs_obj);
  602.             tmp1 = subs_in_there;
  603.             temp_pair2 = Frwdtrack(gs_obj,
  604.                      subst_prop(CDR(conjuncts),temp_pair1->subst),
  605.                    nconc(tmp1,temp_pair1->subst),prev_substs);
  606.             if(temp_pair2->subst != NULL)
  607.                 {
  608.             ret_pair->subst = 
  609.                   nconc(temp_pair1->subst,temp_pair2->subst);
  610.             Min(temp_pair1->certainty,temp_pair2->certainty,cert);
  611.             ret_pair->certainty = (*cert);
  612.             return ret_pair;
  613.             }
  614.             else 
  615.             {
  616.              return Backtrack(gs_obj,TRUE);
  617.             }
  618.            }
  619.            else
  620.            {
  621.                puts("\n*** Yow! Out of core ***\n");
  622.            }
  623.            }
  624.        else
  625.        {
  626.            ret_pair->subst = NULL;
  627.            ret_pair->certainty = 0.0;
  628.            return ret_pair;
  629.        }
  630.       }
  631. }
  632.    
  633.  
  634.  
  635.              Listing 8-5 A Sample Program for Achieve-Goal
  636.  
  637. /*
  638. **    achieve.c
  639. **
  640. **    Description:   This program is to implement backward reasoning.
  641. **
  642. **    Include:       achieve(),achieve_conjunction();     
  643. **
  644. */
  645.  
  646. /*--------------------------------------------------------include--------*/
  647.  
  648. #include <stdio.h>
  649. #include <math.h>
  650. #include "cons.h"
  651. #include "rule.h"
  652. #include "fact.h"
  653. #include "goal.h"
  654.  
  655.  
  656. /*--------------------------------------------------achieve_conjunction----*/
  657.  
  658. /*
  659. ** achieve_conjunction():
  660. **
  661. ** If we're backtracking with prev_substs and there is no saved 
  662. ** goal on the stack, that could mean
  663. ** that we haven't tried the goal yet at all and the prev_substs
  664. ** are from somewhere else.
  665. **
  666. ** Return struct Ret_Pair (pair of substitution,certainty).
  667. **
  668. ** E.g.
  669. **
  670. ** Predicate Base:
  671. **        ((a 1), 1.0), ((a 2), 1.0), ((b 2), 0.9)
  672. **
  673. ** achieve_conjunction(((a ?x)(b ?x)),NULL) ===> (((?x 2)), 0.9)
  674. **
  675. ** 
  676. */
  677.  
  678. Ret_Pair  *achieve_conjunction(conjunction,prev_substs)
  679.  
  680. cons      *conjunction;
  681. cons      *prev_substs;
  682.  
  683. /*------------------------------------------------------------------------*/
  684. {
  685.     Ret_Pair      *ret_pair,*temp1;
  686.     Goal_Stack    *gs_obj;
  687.     Goal_Frame    *gf;
  688.     cons          *tmp1;è
  689.     #ifdef  DEBUG
  690.         printf("\nIn Achieve_Conjunction");
  691.         printf("\nconjunction == ");
  692.         lprint(conjunction,C_FILE,stdout);
  693.         printf("  prev_substs == ");
  694.         lprint(prev_substs,C_FILE,stdout);
  695.     #endif    
  696.         
  697.     gs_obj = NULL;
  698.         ret_pair = init_ret_pair();        
  699.     gs_obj = Find_Goal_Stack(conjunction,prev_substs);
  700.     if(prev_substs == NULL || gs_obj == NULL)
  701.     {
  702.         gs_obj = Create_Goal_Stack(conjunction);
  703.         Add_Goal_Stack(gs_obj);        /*push into goal stack*/
  704.         ret_pair = Frwdtrack(gs_obj,conjunction,NULL,prev_substs);
  705.         }
  706.     else
  707.     {
  708.         temp1 = Backtrack(gs_obj,FALSE);
  709.         if(temp1->subst != NULL)
  710.          {
  711.             gf = gs_obj->goal_frame_list;
  712.             tmp1 = gf->sit;
  713.             ret_pair->subst = nconc(tmp1,gf->soln);
  714.             ret_pair->certainty = temp1->certainty;
  715.         }
  716.         }
  717.     if(ret_pair->subst != NULL)
  718.     {
  719.         gs_obj->prev_subst = push(ret_pair->subst,gs_obj->prev_subst);
  720.     }
  721.         #ifdef  DEBUG
  722.          printf("\nreturn from Achieve_conjunction");     
  723.          printf("\nret_pair.subst == ");
  724.          lprint(ret_pair->subst,C_FILE,stdout);
  725.          printf("ret_pair.cert ==  %g",ret_pair->certainty);
  726.     #endif
  727.     return ret_pair;
  728. }
  729.  
  730.  
  731.  
  732.  
  733.  
  734. /*-------------------------------------------------------achieve()--------*/
  735.  
  736. /*
  737. ** Attempts to achieve goal, returning a substitution and certainty
  738. ** Only dealing with the conjunction premises.
  739. ** 
  740. ** E.g.
  741. **
  742. ** Rule Base:è**      1 IF ((a ?z)) THEN (b ?z) 1.0
  743. **      2 IF ((b ?w)) THEN (c ?w) 0.9
  744. **      3 IF ((c ?x)(d ?x)) THEN (e ?x) 1.0
  745. **      4 IF ((e ?x)) THEN (f ?x) 0.8
  746. ** Predicate Base:
  747. **      ((a 6), 0.8), ((a 3), 0.6), ((d 3), 1.0)
  748. **
  749. ** achieve((f ?y),NULL)  ===>  (((?y 3)), 0.432)
  750. **
  751. */
  752.  
  753. Ret_Pair  *achieve(goal,prev_substs)
  754.  
  755. cons     *goal;
  756. cons     *prev_substs;
  757.  
  758. /*-------------------------------------------------------------------------*/
  759. {
  760.     Ret_Pair  *ret_pair;
  761.  
  762.     #ifdef  DEBUG
  763.         printf("\nIn achieve.c");
  764.         printf("\ngoal == ");
  765.         lprint(goal,C_FILE,stdout);
  766.         printf("  prev_substs == ");
  767.         lprint(prev_substs,C_FILE,stdout);
  768.     #endif    
  769.         
  770.         ret_pair = init_ret_pair();        
  771.     if(!equal(prev_substs,ltwotees()))
  772.     {
  773.         if(!ATOM(CAR(goal)))         /*only deal with conjunction*/
  774.         {
  775.                 ret_pair = achieve_conjunction(goal,prev_substs);
  776.             }
  777.         else 
  778.              {
  779.              ret_pair = lookup_pkb_fact(goal,prev_substs);    
  780.              if(ret_pair->subst == NULL)      /*not find in pkb*/
  781.              {
  782.                  ret_pair = backward_chain(goal,prev_substs);
  783.                  }
  784.              }
  785.     }
  786.         #ifdef  DEBUG
  787.          printf("\nreturn from Achieve.c");     
  788.          printf("\nret_pair.subst == ");
  789.          lprint(ret_pair->subst,C_FILE,stdout);
  790.          printf("ret_pair.cert ==  %g",ret_pair->certainty);
  791.     #endif
  792.     return ret_pair;
  793. }
  794.